home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software of the Month Club 1996 June
/
Software of the Month Club 1996 June.iso
/
mac
/
ISO9660
/
DOS
/
DTP
/
AURORA
/
EXT.AML
< prev
next >
Wrap
Text File
|
1995-02-24
|
73KB
|
2,794 lines
// ───────────────────────────────────────────────────────────────────
// The Aurora Editor v2.0
// Copyright 1993-1995 nuText Systems. All Rights Reserved Worldwide.
//
// Editor library extensions (included by MAIN.AML)
//
// *You should be very familiar with AML before making changes here*
// If you have made any changes, save this file and select 'Recompile
// the Editor' <alt f2> from the Set menu. Exit and re-enter the
// editor for your changes to take effect.
// ───────────────────────────────────────────────────────────────────
// ───────────────────────────────────────────────────────────────────
// All windows
// ───────────────────────────────────────────────────────────────────
object a
// get the drive and path portion of a filespec
function getpath (file)
return file [1 : pos "\\" file 'r']
end
// get the name and extension portion of a filespec
function getname (file)
return file [(pos "\\" file 'r') + 1 : 0]
end
// get the extension portion of a filespec
function getext (file)
p = pos '.' file 'r'
if? p file [p : TO_END] ''
end
// append a default extension for filenames that don't have one
function defext (file extension)
if pos '.' file then
file
else
file + '.' + extension
end
end
// force a filename to have an extension
function forceext (file ext)
p = pos '.' file 'r'
return (if? p file [1 : p] file + '.') + ext
end
// generate <shiftdown>, <shiftup> events from raw <shiftkey> event
function <shiftkey> (newstate oldstate)
send ( if newstate & 3 and not (oldstate & 3) then
"shiftdown"
elseif oldstate & 3 and not (newstate & 3) then
"shiftup"
end )
end
// generate multi-key events
function prefix (keycode)
keyname = locase (getkeyname keycode)
say keyname + "<more...>"
keyname2 = locase (getkeyname (getkey))
queue keyname + keyname2
// allow the <ctrl> key to be held down...
if keyname [1:5] == "<ctrl" and keyname2 [1:5] == "<ctrl" then
queue keyname + '<' + keyname2 [7 : TO_END]
end
display
end
// repeat keys for a user-specified number of times
function askrepkey
var keystring
var i
say "Enter keys to repeat, then <esc>:"
hidecursor
keycode = getkey
while keycode <> <esc> do
keystring = keystring + (char2 keycode)
keycode = getkey
end
if keystring then
count = ask "Number of repetitions"
if count then
strlen = sizeof keystring
while count do
j = 1
while j < strlen do
queuekey (bin2int keystring [j : 2])
j = j + 2
end
repeat
dispatch
until not event?
count = count - 1
end
end
end
end
// a simple file picklist
function picklist (filespec title)
filespec = qualify filespec (getbufname)
repeat
filespec = askfile filespec filespec + title _FmgrSort _FmgrOpt
until not (filespec and (dir? filespec))
return filespec
end
// execute a fully qualified DOS program
// (saving and restoring the current path)
function os (program options)
cp = getcurrpath
currpath (getpath (getbufname))
r = exec program options
currpath cp
return r
end
// shell to DOS by executing COMMAND.COM
function shell
os (getenv "COMSPEC") "ch"
end
// execute DOS commands, programs, and .bat files
function run (file options)
if file then
os (getenv "COMSPEC") + " /c " + file options
else
shell
end
end
// execute DOS commands or programs and capture the output
// via DOS piping (will not capture .bat file output)
function runcap (command options)
_cap = _cap + 1
capfile = qualify "capture." + _cap (getbufname)
run command + '>' + capfile options
open capfile
deletefile capfile
end
// translate an AML compiler error code to an error message
function errormsg (error)
case error
when 1001 "Can't open file"
when 1002, 1003 "Read error"
when 1004 "Not an executable macro file"
when 1031 "Write error"
when 1032 "Can't open compiler output file"
when 1101 "No closing quote"
when 1102 "No closing bracket"
when 1103 "Invalid symbol"
when 1104 "Invalid key or event"
when 1301 "No terminator"
when 1302 "Unexpected end of source"
when 1303 "No closing parenthesis"
when 1310 "Unexpected argument"
when 1311 "Unexpected terminator"
when 1312 "Unexpected function"
when 1313 "Unexpected operator"
when 1319 "Identifier '" + (geterror 's') + "' not defined"
when 1320 "Bad assignment"
when 1330 "Bad when clause"
when 1336 "Improperly placed break"
when 1337 "Invalid reference"
when 1501 "Can't open include file " + (geterror 's')
when 1502 "Include level exceeded"
when 1503 "Can't include compiled file in expression"
when 1504 "Include must be at top level"
when 1505 "Define can't be nested"
when 1506 "Function must be at top level"
when 1507 "Can't redefine builtin function"
when 1508 "Duplicated function argument"
when 1509 "Object statement not permitted"
when 1701 "Too many variables"
when 1702 "Too many function arguments"
when 1703 "Function or expression too large"
when 1704, 1705, 1707 "Internal stack overflow"
when 1706 "Out of symbol space"
otherwise "Fatal compilation error " + error
end
end
// compile a macro with error messages
// the cursor is moved to any syntax errors
function compilemacro2 (source dest msg)
if not source then
source = getbufname
end
say (if? msg msg "Compiling...")
source = qualify (defext source "aml") (getbufname)
error = compilemacro source (if? dest dest (forceext source 'x'))
if error then
// get additional error info
column = geterror 'k'
line = geterror 'l'
file = geterror 'f'
// translate error code to an error message
msg = errormsg error
// position the cursor to the error
if error <> 1001 and (open file) then
gotopos column line
send "onfound"
end
// display the error
msgbox file + " (line " + line + ", col " + column + "): " + msg
"Error!" 'b'
else
say "Done."
end
return error
end
// regenerate the editor boot macro (a.x)
function regen (msg)
dest = bootpath "main.x"
error = compilemacro2 (bootpath "main.aml") dest msg
if not error then
bootfile = bootpath "a.x"
deletefile bootfile
renamefile dest bootfile
end
return error
end
// regenerate the editor boot macro (a.x) with a message
function recompile
if not regen then
msgbox "Exit and re-enter for changes to take effect. "
end
end
// regenerate the editor boot macro (a.x) with a message,
// and integrate current config variables in compilation
function saveconfig
configx = bootpath "config.x"
saveobject "prf" configx
regen "Saving..."
deletefile configx
end
// load and run a compiled macro file
function includemacro2 (macrofile)
includemacro (qualify (forceext
(if? macrofile macrofile (getbufname)) 'x') (getbufname))
end
// load, run, and discard a compiled macro file
function runmacro2 (macrofile)
runmacro (qualify (forceext
(if? macrofile macrofile (getbufname)) 'x') (getbufname))
end
// send a string to the default printer device
function printstr (string)
if string then
fileid = openfile _PrtDev 'w'
if fileid then
writefile fileid string
closefile fileid
end
end
end
// open a new file
function opennew (file options)
prevbufname = getbufname
buffer = createbuf
if buffer then
setbufname (qualify (if? file file "NEW.TXT") prevbufname)
openbuf buffer options
end
end
// toggle the video mode between 80x25 and 80x50
function togglemode
videomode 80 (if? getvidrows == 25 50 25)
end
// search/replace with verification
// (returns the number of replacements made)
function replver (searchstr replstr options)
var title
var count
repeat
length = find searchstr options
if length then
if not title then
title = gettitle
settitle "Replace (Yes/No/All/One/Reverse/Undo/Quit)? "
// remove global for next find
options = sub 'g' '' options
end
send "onfound" length
// get keycode and convert to lower case
p = getkey | 020h
case p
when <y>, <o>, <a>
undobegin
l = (replace searchstr replstr (sub 'r' '' options) + "*z") - 1
if not (pos 'r' options) then
right l
end
count = count + 1
if p <> <y> then
length = ''
if p == <a> then
count = count + (replace searchstr replstr options + "az")
end
end
undoend
when <u>
if count then
undo
count = count - 1
if pos 'r' options then
right 1
else
if getcol == 1 then
if up then
col 16000
end
else
left l
end
end
end
when <n>
// do nothing
when <r>
options = if? (pos 'r' options) (sub 'r' '' options) options + 'r'
otherwise
if not count then
count = '0'
end
break
end
end
until not length
if title then
settitle title
end
return count
end
// search for a multi-string search argument
function search (searchstr reverse rep refopt refrepl)
var replstr
var options
// split up search multi-string
if pos '/' searchstr then
n = splitstr '' searchstr ref searchstr ref replstr ref options
if n > 1 then
if n == 2 then
options = replstr
replstr = ''
// case sensitive
if not options then
options = 'c'
end
end
end
end
if searchstr then
// default options
if not options then
options = _SearchOpt
if n > 2 then
options = options + _ReplaceOpt
end
end
// reverse search direction if specified
if reverse then
options = if pos 'r' options then
sub 'r' '' options
else
options + 'r'
end
end
// remove global for repeat find
if rep and (pos 'g' options) then
options = sub 'g' '' options
end
// return values for calling function to check
refopt = options
refrepl = n >= 3
// resurface marked window for block search
if pos 'b' options then
buffer = getmarkbuf
if buffer and buffer <> getcurrbuf then
currwin (getcurswin (getcurrcurs buffer))
end
end
// search and replace
if n >= 3 then
// do the replace
if pos 'a' options then
replace searchstr replstr options
else
replver searchstr replstr options
end
// search only
else
find searchstr options
end
end
end
// hot key for the file mgr and file picklists
function onhotkey (character)
searchstr = '^[~ ]' + (upcase character)
if find searchstr 'x' then
adjustrow getviewrows / 3
return
else
line = getrow
gotopos 1 1
if find searchstr 'x*' then
adjustrow getviewrows / 3
return
end
// not found
beep 320 70
row line
end
end
object mon
// erase key macros
function erasekey2 (options)
if erasekey options then
_kd = TRUE
display
say (if? (pos options 'a') "All keys macros erased"
"Scrap key macro erased")
end
end
// toggle the key macro record mode
function record
if not playing? then
_kd = TRUE
if not setting? 'R' then
erasekey
record_on = TRUE
end
setting 'R' TOGGLE
say "Record" + (if? record_on "ing..." " OFF")
end
end
// play a key macro
function play (keymacro)
setdisplay OFF
if not (playkey keymacro) then
say "No key macro to play." 'b'
end
setdisplay ON
end
// ───────────────────────────────────────────────────────────────────
// Edit windows and File Manager windows
// ───────────────────────────────────────────────────────────────────
object edit_fmgr
// close all windows
function closeall (options)
setxobj "__G" ON 'a'
begdesk
while getwincount and (send "close" options) end
enddesk
setxobj "__G" OFF 'a'
end
// move the cursor to any edge of a mark
function gotomark (options)
if mark? then
window = getcurswin (getcurrcurs (getmarkbuf))
if window then
currwin window
end
// left or right
if pos 'l' options then
col (getmarkleft)
elseif pos 'r' options then
col (getmarkright)
end
// top or bottom
if pos 't' options then
row (getmarktop)
elseif pos 'b' options then
row (getmarkbot)
end
if window then
send "onfound"
end
else
say "Block not found" 'b'
end
end
// goto a bookmark with message
function gotobook2 (bookmark)
msg = "Bookmark '" + bookmark + "'"
if gotobook bookmark then
window = getcurswin (getcurrcurs (getbookbuf bookmark))
if window <> getcurrwin then
currwin window
end
display
say msg
else
say msg + " not found" 'b'
end
end
// prompt to goto a bookmark
function askbook (msg)
askx (if? msg msg "Bookmark Name") "_book" "gotobook2"
end
// cycle though all existing bookmarks
function cyclebook
repeat
l = _lb
bookmark = if? l (getprevbook l) (getcurrbook)
buffer = getcurrbuf
while not bookmark and buffer do
buffer = getprevbuf buffer
bookmark = getcurrbook buffer
end
_lb = bookmark
until bookmark or not l
gotobook2 bookmark
end
// print the current buffer or mark
function print (options)
printstr _PrtIni
header = _PrtHdr
if not (posnot ' ' header) or (dir? (getbufname)) then
date = getdate
header = getbufname + " (" + date [posnot ' ' date : TO_END] +
' ' + gettime + ')'
end
if not ( if pos 'b' options then printblock _PrtDev header ''
else printbuf _PrtDev header end ) then
say "Print failed" 'b'
end
end
// replace/append/cancel or ok/cancel menus
function askrac (file menuname)
if _ConRpl == 'y' and (locatefile file) then
locase (popup (if? menuname menuname "rac" )
file + " Exists" +
(if? menuname == "ok" ". Replace?")) [1]
else
'r'
end
end
// generic prompt to change a configuration variable
function askc (pstring variable history)
newvalue = ask pstring history (lookup variable "prf")
if newvalue then
setxobj variable newvalue "prf"
end
end
// prompts to change specific configuration variables
function askbinary askc "Binary Line Length" "BinaryLength" end
function askdelim askc "Line Delimiter String in Hex" "LineDlm" end
function asktabw askc "Tab Width" "TabWidth" end
function asktabv askc "Variable Tabs" "VarTabs" end
function asklmarg askc "Left Margin" "LMargin" end
function askrmarg askc "Right Margin" "RMargin" end
function askclip askc "Clipboard Name" "ClipName" end
function askprthdr askc "Current Header/Footer" "PrtHdr" end
// generic prompt with command execution
function askx (pstring history func parm2)
parm1 = ask pstring history
if parm1 then
send func parm1 parm2
if history then
addhistory history parm1
end
return 1
end
end
// open prompt
function askopen
file = ask "[file/ibcenz] Open" "_load"
if file then
// addhistory not needed for open
open file
end
end
// open binary prompt
function askopenb
askx "File to open in Binary Mode" "_load" "open" 'b'
end
// macro expression prompt
function askeval
if askx "Macro Expression" "_cmd" "eval" then
error = geterror 'c'
if error then
msgbox "Expression column " + (geterror 'k') +
": " + (errormsg error) "Error" 'b'
end
end
end
// prompt to include a macro
function askimacro
askx "Include Macro File" "_load" "includemacro2"
end
// prompt to run a macro
function askrmacro
askx "Run Macro File" "_load" "runmacro2"
end
// prompt to compile a macro
function askcmacro
askx "Compile Macro File" "_load" "compilemacro2"
end
// macro picklist
function pickmacro
macro = askfile getbootpath + "MACRO\\*.X" "Select a macro to run"
_FmgrSort _FmgrOpt "maclist"
if macro then
runmacro macro
end
end
// DOS command prompt
function askrun
askx "DOS Command" "_os" "run" "ck"
end
// prompt to capture DOS output
function askruncap
askx "Capture DOS Output" "_os" "runcap" 'c'
end
// open key macro file with messages
function openkey2 (file)
if openkey file then
say (getname file) + " loaded"
else
say "Load failed" 'b'
end
end
// prompt to open a key macro file
function askopenkey
file = ask "Key macro filename" "_load"
if file then
openkey2 (qualify (defext file "mac") (getbufname))
end
end
// prompt to save current key macros
function asksavekey
file = ask "Save current key macros as" "_load"
if file then
file = qualify (defext file "mac") (getbufname)
if pos (askrac file "ok") "or" 'i' then
if not savekey file then
say "Save failed" 'b'
end
end
end
end
// search files for a string in multi-string format with msgs
function searchfiles (s)
var searchstr
var filespec
var options
n = splitstr '' s ref searchstr ref filespec ref options
if n < 3 then
options = _SearchOpt
if n < 2 then
filespec = '.'
end
end
if searchstr then
r = scanfiles filespec searchstr options
if r <= 0 then
say (if? r filespec s) + " not found" 'b'
else
addhistory "_find" (joinstr '' searchstr options)
end
end
end
// prompt to scan files for a string
function askscan
scanstring = if _PromptStyle == 'd' then
scandlg
else
ask "[string/files/iwx] Scan" "_scan"
end
if scanstring then
searchfiles scanstring
addhistory "_scan" scanstring
end
end
// reload the current file from disk
function reopen (file)
open (if? file file getbufname) 'r'
end
// open last file or directory
function openlast
file = gethiststr "_load"
if file then
open file
end
end
// open an AML configuration file in boot directory
function opencfg (file)
open (bootpath file + ".aml")
end
// quick reference help
function quickref (options openopt)
quickfile = getbootpath + (if? options <> 'o' "DOC\\") +
case options [1]
when 'l' "LANGUAGE.DOX"
when 'f' "FUNCTION.DOX"
when 'q' "QUICKFUN.DOX"
when 'o' "ORDERFRM.DOC"
when 't' "TIPS.DOX"
otherwise "USER.DOX"
end
if (wintype? "edit") and (pos 'w' options) then
wordstr = send "getword" "a-zA-Z0-9?"
end
open quickfile openopt
if wordstr then
gotopos 1 1
// find string in reference
if find (char 0ffh) + wordstr + (char 0ffh) then
right
send "onfound" (sizeof wordstr)
// not found? then try function header in EXT.AML
elseif poschar 'fq' options then
close
ext = bootpath "EXT.AML"
closeit = _MultCopy == 'n' and not (findbuf ext)
open ext openopt
gotopos 1 1
n = find "function #" + wordstr 'x'
if n then
send "onfound" n
else
// still not found? then go back to the reference
if closeit then
close
end
open quickfile openopt
end
end
end
end
// popup menu to change the default prompt style
function askprompt
menu "prompts"
item " &Command line" 1
item " &One-line box" 2
item " &Two-line box" 3
item " &Dialog box" 4
end
newtype = popup (getcurrbuf) "Select a Prompt Style" 25
if newtype then
setobj _PromptStyle "c12d" [newtype] "prf"
end
destroybuf "prompts"
end
// ───────────────────────────────────────────────────────────────────
// Prompts and Edit windows
// ───────────────────────────────────────────────────────────────────
object prompt
// support for cua-style <shift> key marking
function smark
if shiftkey? then
if _shfx then
undobegin
destroymark
markstream _shfx _shfx _shfy _shfy
_shfx = ''
_shfy = ''
end
extendmark
end
end
// set anchor for shift-key marking
function shiftdown
_shfx = getcol
_shfy = getrow
pass
end
// end shift-key mark
function shiftup
stopmark
pass
undoend
end
// backspace in a prompt
function backsp
if getcol > 1 then
left
delchar
end
end
// get the word at the cursor
function getword (charset column mark)
if not column then
column = getcol
end
if column <= getlinelen then
if not charset then
charset = _CSet
end
b = posnot charset (gettext column)
if b <> 1 then
b = if? b column + b - 2 getlinelen
a = posnot charset (gettext 1 column) 'r'
a = if? a a + 1 1
if mark then
undobegin
destroymark
markchar a b
undoend
else
gettext a b - a + 1
end
end
end
end
// mark the word at the cursor using getword
function markword (charset)
getword charset '' 1
end
// mark to end-of-line
function markeol
undobegin
destroymark
if getcol <= getlinelen then
markchar (getcol) (getlinelen)
end
undoend
end
// delete a block
function deleteblock2
if getmarkbuf == getcurrbuf then
deleteblock
else
if wintype? "edit" then
if _DelLine == 'y' then
delline
end
end
end
end
// prompt to enter character literally
function literal
say "Enter Literal..."
queue <char> (char getkey & 0ffh)
end
// ascii chart with character entry
function asciilist
buffer = asciibuf
// name it so the position can be remembered
setbufname "_asc"
character = (popup buffer '' 13) [10]
destroybuf
if character then
queue <char> character
end
end
// support for file name completion (open prompts only)
function askcomplete
if gethistname == "_load" then
filespec = gettext
if filespec then
if not pos "*.*" filespec then
filespec = filespec + (if? (pos '.' filespec) '*' "*.*")
end
else
filespec = "*.*"
end
file = picklist (qualify filespec (getbufname (getwinbuf (getprevwin))))
if file then
col 1
delchar (getlinelen)
writetext file
return file
end
end
end
// get the first line of text in the default mark
function getmarktext
if mark? then
buffer = getmarkbuf
topline = getmarktop
if getmarktype == 'l' then
gettext (getlinebeg topline buffer) (getlinelen topline buffer)
(getmarktop) buffer
else
gettext (getmarkleft) (getmarkcols) topline buffer
end
end
end
// copy or copy-append to the clipboard
function copy (options)
if mark? then
currentbuf = getcurrbuf
clip = _ClipName
destroymark clip
copymark (getmarkuse) clip
// copy
if options and (buffer? clip) then
if getmarktype <> 'l' then
insline '' '' (getlines clip) clip
end
copyblock clip clip 1 (getlines clip)
markline 1 (getlines clip) clip clip
// copy append
else
destroybuf clip
createbuf clip
copyblock clip clip
if getmarktype == 'l' then
delline 1 1 clip
end
end
currbuf currentbuf
end
end
// cut or cut-append to the clipboard
function cut (options)
if mark? then
copy options
deleteblock
end
end
// enter a character or string into the current prompt
function write (charstring)
writetext charstring
end
// ───────────────────────────────────────────────────────────────────
// Edit windows
// ───────────────────────────────────────────────────────────────────
object edit
// mark a paragraph
function markpara
if getlinelen then
undobegin
destroymark
// find the beginning of the paragraph
pushcursor
while up and getlinelen end
if not getlinelen then
down
end
markline
popcursor
// find the end of the paragraph
pushcursor
while down and getlinelen end
if not getlinelen then
up
end
markline
popcursor
undoend
return 1
end
end
// setup for insert-above (copy, move, paste - lineblocks only)
function begabove
_ba = ''
undobegin
if _InsAbove == 'y' and getmarktype == 'l' then
_ba = 1
if not up then
insabove
up
_ba = 2
end
end
end
// end insert-above
function endabove
case _ba
when 1 down
when 2 delline
end
undoend
end
// paste or paste-over from the clipboard
function paste (options)
if mark? _ClipName then
destroymark
copymark _ClipName (getmarkuse)
if options then
copyblockover
else
begabove
copyblock
endabove
end
else
say "Nothing to paste" 'b'
end
end
// clear the clipboard
function clear
destroybuf _ClipName
end
// copy a block
function copyblock2
if mark? then
begabove
if not copyblock then
say "Copy failed" 'b'
end
endabove
else
if _CopyLine == 'y' then
undobegin
markline
copyblock
destroymark
undoend
end
end
end
// move a block
function moveblock2
begabove
if getmarktop < getviewtop then
y = 1 + getrow - (apparentrow getviewtop - getrow)
end
if moveblock then
if y then
adjustrow y
end
else
say "Move failed" 'b'
end
endabove
end
// move a block over text
function moveblockover
if mark? then
undobegin
copy
fillblock ' '
paste 'o'
undoend
end
end
// reformat a block or the current paragraph
function formatblock2 (options)
undobegin
if not mark? then
if markpara "tb" then
markcolumn (getcol) _RMargin (getmarktop) (getmarkbot)
flag = ON
end
end
// special case for single lines
if getmarkrows == 1 and getcol < getlinebeg then
delchar getlinebeg - getcol
else
formatblock _LMargin _RMargin options
end
if flag then
destroymark
end
undoend
end
// simple text quoting support for a block or the current paragraph
function quote
undobegin
if not mark? then
tempmark = TRUE
markpara
end
if mark? then
shiftblock 1 '' '>'
if tempmark then
destroymark
end
else
say "Nothing to quote"
end
undoend
end
// sort a block
function sortblock2
sortblock
// scrollock ON=descending // insert ON=ignore case
(if? (shiftkey? 10h) 'd') + (if? (insert?) 'i')
end
// prompt to fill a block with a string
function fillblock2
askx "Enter fill string" '' "fillblock"
end
// prompt to save a block
function saveblock2 (options)
var c1
var c2
if mark? then
file = ask "Save block as" "_load"
if file then
file = qualify file (getbufname)
addhistory "_load" file
if fileattr? file 'r' then
say "Read Only!" 'b'
else
action = locase (askrac file)
if pos action "ra" then
send "oncomment" file ref c1 ref c2
options = _SaveOpt + options
if not saveblock file
(if? (pos 'e' options) 'e' + _TabWidth) + options +
(if? action == 'a' 'a') ''
'' '' (if? c1 c1 + _FoldSign) c2 then
msgbox "Save Failed!" "Error!" 'b'
end
end
end
end
else
say "No marked block" 'b'
end
end
// left justify, center, or right justify a block
function justblock2 (options)
justblock options '' _LMargin _RMargin
end
// destroy open and closed folds
function destroyfold2
undobegin
if not fold? then
closefold
end
destroyfold
undoend
end
// do fold operations on entire file
function foldall (options)
undobegin
usemark 'T'
markline 1 (getlines)
foldblock options
destroymark
usemark
undoend
end
// fold a block or the current paragraph
function foldblock2
undobegin
if mark? then
foldblock
elseif markpara then
foldblock
destroymark
end
undoend
end
// fold a block and destroy subfolds
function foldflat
undobegin
foldblock 'ds'
foldblock
undoend
end
// fold or unfold a line
function foldline (options)
undobegin
usemark 'T'
markline
unfold = pos 'u' options
if fold? then
foldblock 'd'
if not unfold or getmarkrows > 1 then
bottom = actualrow (if? unfold -1 1) (getmarkbot)
if not (getfold 'o' bottom) then
markline (getrow) bottom
end
foldblock
end
else
if not unfold then
foldblock
end
end
destroymark
usemark
undoend
end
// detab or entab the current file
// (+width=detab, -width=entab)
function tabfile (width)
undobegin
usemark 'T'
markline 1 (getlines)
tabblock (if? width width _TabWidth)
destroymark
usemark
undoend
end
// insert a line after the current line with autoindent
function insline2
undobegin
insline
if setting? 'A' then
if getlinelen then
col (getlinebeg)
else
nextline = getrow + 2
if getlinelen nextline then
col (getlinebeg nextline)
end
end
end
down
undoend
end
// swap the current line with the next line
function swapline
undobegin
usemark 'T'
markline
stopmark
down
moveblock
destroymark
usemark
undoend
end
// center the current line
function centerline
undobegin
usemark 'T'
markline
justblock 'c' '' _LMargin _RMargin
destroymark
usemark
undoend
end
// comment or uncomment a line
function commentline (c1 c2)
if not c1 then
send "oncomment" (getbufname) ref c1 ref c2
if not c1 then
c1 = '>'
end
end
undobegin
column = getlinebeg
if (gettext column (sizeof c1)) == c1 then
delchar (sizeof c2) getlinelen - (sizeof c2) + 1
delchar (sizeof c1) column
elseif getlinelen then
instext c1 (getlinebeg)
if column then
ovltext c2 getlinelen + 1
end
end
down
undoend
end
// find the previous word
function prevword
while getcol > 1 and (poschar _CSet (getchar)) do
left
end
find _CSet "[r"
while getcol > 1 and (poschar _CSet (getchar getcol - 1)) do
left
end
end
// find the next word
function nextword
while poschar _CSet (getchar) do
right
end
find _CSet '['
end
// change the case of the word at the cursor
function caseword (options charset)
undobegin
usemark 'T'
markword charset
caseblock options
destroymark
usemark
undoend
end
// open the filename at the cursor
function openword (charset)
file = getword (if? charset charset _CSetB)
if file then
open file
end
end
// delete the character at the cursor
function delchar2
undobegin
if getcol > getlinelen and _DelJoin == 'y' then
joinline
else
delchar
if setting? 'L' then
livewrap
end
end
undoend
end
// backspace
function backsp
undobegin
if getcol > 1 then
left
if not insert? and _BakOvl == 'y' then
ovltext ' '
else
delchar
if setting? 'L' then
livewrap
end
end
elseif getrow > 1 and _BakJoin == 'y' then
up
col getlinelen + 1
joinline
end
undoend
end
// delete right word
function delword (charset)
if not charset then
charset = _CSet
end
undobegin
if getcol > getlinelen then
joinline
else
p = posnot charset (gettext (getcol))
if p > 1 then
delchar p - 1
end
delchar (
if p then
if getchar == ' ' and
(getcol == 1 or
(posnot charset (getchar getcol - 1))) then
(posnot ' ' (gettext (getcol))) - 1
else
p == 1
end
else
getlinelen
end
)
end
if setting? 'L' then
livewrap
end
undoend
end
// splitline with autoindent
function splitline2 (column)
undobegin
b = getlinebeg
if splitline column then
if not setting? 'A' then
b = _LMargin
end
if b > 1 then
pushcursor
down
usemark 'T'
markline
shiftblock (if? getcol > b b (getcol)) - 1
destroymark
usemark
popcursor
end
end
undoend
end
// <enter> key behavior
function enter
// terminate a word for text translation
lastrow = getrow
if getcol == getlinelen + 1 and getlinelen then
if setting? 'T' then
send <char> ' '
end
end
if getrow == lastrow then
case (if? (insert?) _EnterIns _EnterOvl)
when 'i'
insline2
when 's'
if fold? then
insline2
else
startcolumn = getlinebeg
length = getlinelen
splitline2
down
if setting? 'A' then
if length then
col startcolumn
end
else
startcolumn = _LMargin
col (if? startcolumn startcolumn 1)
end
end
otherwise
down
col (if? (getlinelen) (getlinebeg) _LMargin)
end
end
end
// for use by variable tab right
function vtabr
i = 1
while i <= arg do
if (arg i) <= getcol then
i = i + 1
else
return arg i
end
end
return 0
end
// for use by variable tab left
function vtabl
i = arg
while i do
if (arg i) >= getcol then
i = i - 1
else
return arg i
end
end
return 0
end
// tab support
function tabfunc (next)
oldcolumn = getcol
// smart tabs
if setting? 'S' then
prevline = getrow - 1
while prevline and not (getlinelen prevline) do
prevline = prevline - 1
end
if prevline then
pushcursor
row prevline
send (if? next "nextword" "prevword")
if prevline == getrow then
newcolumn = getcol
end
popcursor
end
end
// variable tabs
if not newcolumn then
if setting? 'V' then
newcolumn = eval (if? next "vtabr " "vtabl ") + _VarTabs
end
// standard interval tabs
if not newcolumn then
width = _TabWidth
if not width then
width = 8
end
newcolumn = oldcolumn +
if next then
width - (oldcolumn - 1) mod width
elseif oldcolumn > 1 then
-((oldcolumn - 2) mod width + 1)
end
end
end
// move to tabstop and shift text if needed
if newcolumn then
if _TabShift == 'y' and insert? then
if newcolumn < oldcolumn then
delchar oldcolumn - newcolumn newcolumn
elseif newcolumn > oldcolumn then
instext (copystr ' ' newcolumn - oldcolumn)
end
end
col newcolumn
end
end
// tab left and right
function tabright tabfunc 1 end
function tableft tabfunc end
// prompt to verify close
function close?
if bufchanged? and not getprevcurs then
savechanges = popup "ync" "Save changes to " +
(getname (getbufname)) + '?'
if savechanges == "Yes" then
save
end
icompare savechanges "Yes" "No"
else
1
end
end
// close an edit window
function close (options)
if pos 's' options then
if save then
pass
end
elseif close? then
pass
end
end
// open and insert prompt
function askinsert
file = ask "File to insert into " + (getname (getbufname)) "_load"
if file then
// addhistory not needed for open
old_size = getlines
undobegin
open file 'i'
// mark the inserted text
if getlines > old_size then
markline getrow + 1 getrow + getlines - old_size
end
undoend
end
end
// prompt to change the current file name
function askname
newname = ask "Rename " + (getname (getbufname)) + " to" "_load"
if newname then
case setname newname
when -1 say "Failed" 'b'
when -2 say "Failed - file already loaded" 'b'
otherwise
addhistory "_load" (getbufname)
end
end
end
// search and replace with messages and highlighting
function search2 (search_str reverse again)
var opt
var rpl
n = search search_str reverse again ref opt ref rpl
if n then
// replace occurred
if rpl then
display
say (thousands n) + " changes made"
// count occurrences
elseif pos 'a' opt then
display
say (thousands n) + " occurrences of '" + search_str + "' found"
// search only
else
onfound n
end
else
display
say "'" + search_str + "' not found" 'b'
end
return n
end
// find prompt
function askfind (reverse)
search_string = if _PromptStyle == 'd' then
finddlg
else
ask "[string/abgirswx] Find" "_find"
end
if search_string then
search2 search_string reverse
addhistory "_find" search_string
end
end
// replace prompt
function askrepl (reverse)
search_string = if _PromptStyle == 'd' then
repldlg
else
ask "[string/replstr/abgirswx] Repl" "_find"
end
if search_string then
search2 search_string reverse
addhistory "_find" search_string
end
end
// do the last find/replace operation
// (reverse=r reverses the search direction)
function findlast (reverse)
search2 (gethiststr "_find") reverse TRUE
end
// incremental search
function isearch
var search_string
repeat
settitle "I-search for [" + search_string + "] "
keycode = getkey
options = _SearchOpt
new_char = ''
case keycode
when <backspace>
if search_string then
popcursor
search_string = if (sizeof search_string) > 1 then
search_string [1 : (sizeof search_string) - 1]
else
''
end
if not search_string then
display
end
options = '*'
end
when <ctrl p>, <ctrl r>
options = 'r'
when <ctrl n>, <ctrl l>
// do nothing
when <ctrl g>, <ctrl b>
options = 'g'
otherwise
keyname = getkeyname keycode
if (sizeof keyname) == 3 then
pushcursor
new_char = keyname [2]
options = '*'
else
// restore window title
settitle (getbufname)
display
// clear all pushed cursors
popcursor "ad"
addhistory "_find" search_string
if keycode <> <enter> and keycode <> <esc> then
queuekey keycode
end
done = TRUE
end
end
if not done and (search_string or new_char) then
new_string = concat search_string new_char
str_length = find new_string _SearchOpt + options
if str_length then
onfound str_length
search_string = new_string
else
say new_string + " not found" 'b'
if new_char then
popcursor
end
onfound (sizeof search_string)
end
end
until done
end
// find occurrences search
function findo (string_and_opt)
var search_string
var options
var o
n = splitstr '' string_and_opt
ref search_string ref options ref o
// initialize search options
if n >= 2 then
if n > 2 then
options = o
end
else
options = _SearchOpt
end
if pos 'g' options then
options = sub 'g' '' options
end
options = options + '*'
// do the search
buffer = createbuf
ovltext "≡≡≡≡≡≡ Select this line to edit occurrences ≡≡≡≡≡≡"
gotobuf (getprevbuf)
pushcursor
gotopos 1 1
while find search_string options do
addline getrow + ": " + gettext '' '' buffer
col MAX_COL
end
popcursor
// display occurrences
if (getlines buffer) > 1 then
bname = getbufname
line = popup buffer
"Occurrences of '" + search_string + "' in "
+ (getname bname) + " - " + ((getlines buffer) - 1) +
" lines" getvidcols - 11 getvidrows - 8
if line then
if line [1] == '≡' then
delline 1 1 buffer
setbufname (qualify "TEMP.TXT" bname) buffer
openbuf buffer
else
destroybuf buffer
gotopos 1 line [1 : (pos ':' line) - 1]
onfound (find search_string options + '*')
end
end
else
destroybuf buffer
display
say "'" + string_and_opt + "' not found" 'b'
end
end
// prompt to find occurrences
function askfindo
search_str = ask "[string/birswx] Find occurrences of" "_find"
if search_str then
findo search_str
addhistory "_find" search_str
end
end
// find all occurrences of last find string
function findlasto
findo (gethiststr "_find")
end
// find matching character (){}[]<>
function gotomatch2
if gotomatch "(){}[]<>" then
onfound 1
else
say "Not found" 'b'
end
end
// goto column
function col2 (column)
case column [1]
when '+' right column [2 : TO_END]
when '-' left column [2 : TO_END]
otherwise col (if? column > MAX_COL MAX_COL column)
end
onfound
end
// goto line
function row2 (line)
case line [1]
when '+' down line [2 : TO_END]
when '-' up line [2 : TO_END]
otherwise row (if? line > getlines (getlines) line)
end
onfound
end
// goto line prompt
function askrow
askx "Line number" "_line" "row2"
end
// goto column prompt
function askcol
askx "Column Number" '' "col2"
end
// set a quick bookmark
function quickbook
_bk = _bk + 1
bookmark = "Book" + _bk
setbook bookmark
display
say "Bookmark " + bookmark + " set"
end
// place a bookmark
function placebook (bookmark)
if not bookmark then
bookmark = ask "Bookmark Name" "_book"
end
if bookmark then
setbook bookmark
display
say "Bookmark '" + bookmark + "' set"
end
end
// Go to the compiler error on the current line of a compiler
// error output file. This function recognizes compiler errors
// of the form:
//
// <text> FILENAME.EXT <text> LINENUMBER <text> : MESSAGE
//
// (implemented by using regular expression searching confined
// to the current line)
function gotoerror
pushcursor
// filename charclass to use (max closure without the period)
fileset = "[a-zA-Z0-9_\-/\\\\@~:^!#$%&`']#"
file_ext = fileset + '\\.' + fileset
// find the filename
length = find file_ext 'xgl*'
if length then
filename = gettext (getcol) length
right length
// find the line number
length = find "[0-9]#" 'xl'
if length then
line = gettext (getcol) length
// find the message
if find ':' 'l' then
message = gettext getcol + 1
popcursor
// open the file
if open filename then
row line
col (getlinebeg)
send "onfound"
say message + ' '
return
end
end
end
end
popcursor
display
say "Compiler message not recognized."
end
// backup a file and return the backup filename if sucessful
function backup (file)
if locatefile file then
dir = _BackupDir
if dir then
if (sizeof dir) > 3 and dir [LAST_CHAR] == "\\" then
dir = dir [1 : (sizeof dir) - 1]
end
createdir dir
dir = qualify dir
backup_file = if pos "*.*" dir then
qualify (getname file) dir
else
msgbox "Unable to create backup file!"
"Warning!"
return 1
end
else
backup_file = forceext file _BackupExt
end
// delete the old backup file
deletefile backup_file
// attempt a rename
if not renamefile file backup_file then
// try copy if rename fails
if (copyfile file backup_file) <= 0 then
msgbox "File backup failed!" "Error"
return 0
end
end
return backup_file
else
return 1
end
end
// save the current file to disk
function save (file options)
var c1
var c2
// check for a truncated file
if trunc? and
not (icompare (popup "ok" "Truncated file - are you sure?") "Ok") then
return
end
file = if file then
qualify file (getbufname)
else
getbufname
end
if fileattr? file 'r' then
say "Read Only!" 'b'
else
backup_file = 1
if setting? 'B' then
backup_file = backup file
end
if not backup_file then
say "Backup failed" 'b'
else
send "onsave" file
// get fold comments for the file (if any)
send "oncomment" file ref c1 ref c2
options = _SaveOpt + options
if not savebuf file
(if? (pos 'e' options) 'e' + _TabWidth) + options ''
(if not getbinarylen then hex2bin _LineDlm end) ''
(if? c1 c1 + _FoldSign) c2 then
// restore the backup after save failure
if backup_file <> 1 then
if not renamefile backup_file file then
copyfile backup_file file
end
end
msgbox "Save failed! Check file path / file attributes / disk space" "Error!" 'b'
return 0
else
1
end
end
end
end
// save-as prompt
function asksaveas (options)
file = ask "Save " + (getname (getbufname)) + " as" "_load"
if file then
file = qualify file (getbufname)
addhistory "_load" file
save file options
end
end
// start, stop, or do autosave
function autosave (seconds)
if not seconds then
if bufchanged? then
save
end
elseif seconds < 0 then
destroytimer "asav"
else
setrepeat "asav" seconds * 1000 '' "autosave"
end
end
// prompt for autosave interval in seconds
function askasave
seconds = ask "Autosave interval in secs (-1=disable)"
if seconds then
autosave seconds
end
end
// highlight all occurrences of the word at the cursor
function hiliteword
sobj = send "onsyntax" (getbufname)
if not sobj then
setting 'X' DEFAULT
sobj = "syndef"
end
if sobj then
w = send "getword" "a-zA-Z_0-9?"
if w then
// create a color selection menu
menu "hcolor"
item " &None" -1
item " &Default" -2
item "-"
item " &Black" color white on black
item " B&lue" color yellow on blue
item " &Green" color white on green
item " &Cyan" color white on cyan
item " &Red" color white on red
item " &Magenta" color white on magenta
item " Br&own" color white on brown
item " Gr&ay" color white on gray
item "-"
item " Dar&kgray" color white on darkgray
item " Brightbl&ue" color white on brightblue
item " Brightgr&een" color black on brightgreen
item " Brig&htcyan" color black on brightcyan
item " Br&ightred" color white on brightred
item " Brightmagen&ta" color white on brightmagenta
item " &Yellow" color black on yellow
item " &White" color black on white
end
setbufname "colorlist"
hcolor = popup "hcolor" "select a color "
// destroy the menu
destroybuf "hcolor"
if hcolor then
if hcolor == -1 then
unsetx w sobj
else
setxobj w (if? hcolor == -2 '' hcolor) sobj
end
end
display
end
end
end
// live word wrap support
function livewrap
if fold? then
return
end
startcol = getlinebeg
if getrow < getlines and (getlinelen getrow + 1) then
n = getlinebeg getrow + 1
startcol = if? n < startcol n startcol
elseif not getlinelen or not (setting? 'A') then
startcol = _LMargin
end
if getcol < startcol then
startcol = getcol
end
if getlinelen then
undobegin
saved_char = getchar
ovltext '■'
// mark to the end of the paragraph
pushcursor
top = getrow
while down and getlinelen do end
if not getlinelen then
up
end
bottom = getrow
popcursor
// reformat
usemark 'T'
markcolumn startcol _RMargin top bottom
formatblock '' '' "kr"
destroymark
usemark
// find the original cursor position
col 1
find '■' '*'
ovltext (if? saved_char saved_char ' ')
undoend
end
end
// enter a character or string at the cursor, with support for:
// - match character
// - translate
// - standard word wrap
// - live word wrap
function write (write_str)
// group together as one undoable operation
undobegin
// enter the character or string at the cursor and
// advance the cursor
writetext write_str
// get the current window settings
setting_str = getsettings
// match character
if pos 'M' setting_str then
instext ( case write_str
when '"' '"'
when '(' ')'
when '[' ']'
when '{' '}'
otherwise ''
end )
end
// translate
if pos 'T' setting_str then
// delimited lookup?
to_word_end = if? (posnot _TranCSet write_str) 2 1
// get the last word typed
word_str = getword _TranCSet (getcol - to_word_end)
if word_str then
lookup_str = word_str + (if? to_word_end == 2 '*')
// lookup the word in the translate object
value = lookup lookup_str _TranObj
if value then
// is it a function? ..then evaluate it
if function? lookup_str _TranObj then
eval value
// otherwise replace the word
else
word_column = getcol - (sizeof word_str) - to_word_end + 1
delchar (sizeof word_str) word_column
instext value word_column
col word_column + (sizeof value) + to_word_end - 1
end
end
end
end
// check for word wrap and live wrap
if getlinelen > _RMargin then
// live word wrap
if pos 'L' setting_str then
livewrap
// standard word wrap
elseif (pos 'W' setting_str) and (not fold?) then
column = getcol
limit = _RMargin + 1
if column > limit then
if write_str <> ' ' then
first_col = if? (setting? 'A') (getlinebeg) _LMargin
split_col = pos ' ' (gettext 1 limit) 'r'
split_col = if? split_col > first_col split_col + 1 limit
splitline split_col
down
markline '' '' 'T'
shiftblock first_col - 1 'T'
destroymark 'T'
col column - split_col + first_col
end
end
end
end
undoend
end
// enter a date/time stamp at the cursor
function timestamp
write getdate + ' ' + gettime
end
// ───────────────────────────────────────────────────────────────────
// File Manager windows
// ───────────────────────────────────────────────────────────────────
object fmgr
// return the file name for fmgr commands
function fname2
if fmark? then
"MARKED FILES"
else
getname (getffile)
end
end
// error notification
function ferror (s)
msgbox s + " Failed" "Error!" 'b'
end
// fmgr confirmation prompt
function fconfirm (confirm pstring func)
if (icompare confirm 'n') or
(icompare (popup "ok" pstring + ' ' + fname2 + '?') "ok") then
fdomark func
reopen
end
end
// internal fopen
function fopn (file options)
if file then
openf file options
else
fdomark "fopn" options
end
end
// fmgr open file(s) command
function fopen (options)
var searchopt
if pos '1' options then
if shiftkey? then
options = options + 'v'
end
scanstr = fscanstr
openf '' options
// find first occurrence for scan windows
if scanstr then
addhistory "_find" scanstr
splitstr '' scanstr '' ref searchopt
gotopos 1 (if? (pos 'r' searchopt) (getlines) 1)
send "onfound" (search scanstr)
end
else
fopn '' options
end
end
// fmgr change file attributes command
function fattr (file attr)
if file then
chgfileattr file attr
else
attr = ask "New attributes [AHSR] for " + fname2
if attr then
fdomark "fattr" (if? attr <> ' ' attr)
reopen
end
end
end
// fmgr delete file(s) command
function fdelete (file)
if file then
if pos "*.*" file then
file = getpath file
end
if not deletefile file 'd' then
ferror "Delete"
end
else
fconfirm _ConDel "Delete" "fdelete"
end
end
// fmgr touch file(s) command
function ftouch (file)
if file then
if not touchfile file then
ferror "Touch"
end
else
fconfirm _ConTch "Touch" "ftouch"
end
end
// print a file or directory with the current printer settings
function printfile (file)
if loadbuf file '' '' _FmgrOpt _TruncLength then
print
destroybuf
end
end
// fmgr print file(s) command
function fprint (file)
if file then
if not printfile file then
ferror "Print"
end
else
fconfirm 'y' "Print" "fprint"
end
end
// fmgr run file command
function frun (options)
run (getffile) options
reopen
end
// fmgr rename file command
function frename
oldname = getffile
newname = ask "Rename " + (getname oldname) + " to" "_load"
if newname then
if renamefile oldname (qualify newname (getbufname)) then
reopen
else
ferror "Rename"
end
end
end
// fmgr copy (or move) file(s) command
function fcopy (source dest options)
if source then
if dir? dest then
dest = qualify (getname source) dest
end
action = askrac dest
if pos action "ra" 'i' then
move? = options == 'm'
say (if? move? "Mov" "Copy") + "ing " + source "..."
if not move? or (icompare action 'a') or not (renamefile source dest) then
if not copyfile source dest (if? (icompare action 'a') 'a') then
ferror (if? move? "Move" "Copy")
fdobrk
else
if move? then
deletefile source
end
end
end
end
else
if fmark? then
dir_dest = qualify (getffile)
if not dir? dir_dest then
dir_dest = ''
end
end
dest = ask (if? options == 'm' "Move " "Copy ") + fname2 + " to"
"_load" dir_dest
if dest then
fdomark "fcopy" (qualify dest (getbufname)) options
reopen
end
end
end
// fmgr move file(s) command
function fmove
fcopy '' '' 'm'
end
// fmgr create new directory command
function fmkdir
dir = ask "New directory name" "_load"
if dir then
if createdir (qualify dir (getbufname)) then
reopen
else
ferror "Create directory"
end
end
end
// ───────────────────────────────────────────────────────────────────
// On-Event functions called by the editor
// ───────────────────────────────────────────────────────────────────
// edit windows & file manager windows only
object edit_fmgr
// called while loading files
function onloading (lines)
say (if? lines "Loading [" + lines + "]..." getbufname)
end
// called while saving files
function onsaving (lines)
say (if? lines "Saving [" + lines + "]..." getbufname)
end
// called while printing files
function onprinting (lines)
say (if? lines "Printing [" + lines + "]... <ctrl break> to stop "
getbufname)
end
// called while scanning files
function onscanning (file found)
// create scan progress window
if not window? 'scan' then
createwindow 'scan'
setwinobj
setframe ">b"
setcolor border_color color white on gray
setcolor text_color color black on gray
settitle "Scanning" 'c'
setborder "1i"
setshadow 2 1
// center the window
width = (sizeof (getpath file)) + 24
height = 16
ox = (getvidcols - width) / 2
oy = (getvidrows - height) / 2
sizewindow ox oy ox + width oy + height "ad"
writestr file + "..."
elseif found then
writestr " FOUND" (color brightgreen on gray) (getcoord 'x1') - 7
elseif file then
writeline
writestr file + "..."
else
destroywindow
end
display
end
// called while compiling files
function oncompiling (file lines)
say (if? lines "Compiling " + file + " [" + lines + "]..." getbufname)
end
// edit windows only
object edit
// called after a file is opened and before it's displayed
function onopen
// set window event object
setwinobj "edit"
// default window settings (if not remembered by open)
if not getsettings then
setting _DefaultSet ON
end
// check for file truncation
if trunc? then
display
say "File Truncated!" 'b'
end
end
// called immediately before a file is saved
//function onsave (file) then
//end
// called when switching to a file
//function onfocus
//end
// called when closing a file
//function onclose
//end
// called after a search to change the window view and
// optionally highlight a string
function onfound (stringlength)
// check if the cursor is outside the window view
if getcol < getviewleft then
if getcol < getviewcols then
rollcol -getviewleft
else
adjustcol 3
end
elseif getcol + stringlength >= getviewright then
adjustcol
end
if getrow > getviewbot then
adjustrow 3
elseif getrow < getviewtop then
adjustrow
end
display
// highlight a string if stringlength is specified
if stringlength then
hilite stringlength 1 (getpalette (if? (inmark?) 9 8))
end
end
object fmgr
// called after a fmgr window is opened and before it's displayed
function onopen
// set the window event object
setwinobj "fmgr"
// check for include picklist
if ftype? 'i' then
display
say "Select file to insert"
end
end
// all windows
object a
// called when sounding an alarm
// (allows you to customize the alarm sound)
function onalarm
beep 750 70
end
// get default comments for a filename (c1, c2 passed by reference)
// (associates a filename with comment symbols)
function oncomment (file c1 c2)
case getext (upcase file)
when ".C", ".AML", ".CPP", ".H" c1 = "//"
when ".ASM" c1 = ';'
when ".PAS" c1 = '{' c2 = '}'
otherwise c1 = '>'
end
end
// called when entering the editor before any windows are open.
// DOS command-line filespecs are passed to this function
function onentry
// save the DOS entry path
_cp = getcurrpath
// open prompt and window history
if _SaveHistory == 'y' then
openhistory (bootpath "history.dat")
end
// process command-line parameters passed to the editor
param_num = 1
parameter = arg 1
while parameter do
// check for command line options
if parameter [1:2] == "-e" then
queue parameter [3 : TO_END]
// open files/directories
else
open parameter
end
// next command line parm
param_num = param_num + 1
parameter = arg param_num
end
// still no windows open? then do bootoptions...
if not getcurrwin then
case _BootOpt
when 'd' restoredesk
when 'f' open '.'
when 'n' opennew
otherwise
filespec = ask "File or Directory" "_load"
if filespec then
open filespec
else
halt
end
end
end
// initialize the mouse
if _Mouse == 'y' then
if openmouse _MouseOpt then
mousepos 15999 + getvidcols 15999 + getvidrows
y_sens = _MouSenY
if (getos 'v') > 9 then
mousesense (_MouSenX * 5) / 8 (y_sens * 5) / 8 _MouDST
else
mousesense _MouSenX y_sens _MouDST
end
end
end
// open key macros if configured
if _SaveMac == 'y' then
openkey (bootpath "a.mac")
end
// set autosave timer
send "autosave" _AutoSave
end
// called when exiting the editor after all windows are closed
function onexit
// open prompt on non-global exit (if configured)
if not __G then
if _ExitOpen == 'y' then
filespec = ask "File or Directory" "_load"
if filespec then
open filespec
end
end
end
// final exit if no windows open
if not getcurrwin then
// save prompt and window history
if _SaveHistory == 'y' then
savehistory (bootpath "history.dat")
end
// save key macros if configured
if _SaveMac == 'y' then
// check if record occurred
if lookup "kd" "mon" then
savekey (bootpath "a.mac")
end
end
// restore entry path saved in onentry
currpath _cp
closemouse
halt
end
end